perm filename NTSB.FAI[XX,LCS] blob
sn#265557 filedate 1977-02-22 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE NOTWRT
C00040 ENDMK
C⊗;
TITLE NOTWRT
ENTRY NOTWRT
EXTERNAL BM,NOZERO,LINX,ROFF,CENTX,STF,LINES,.COMM.,MAKNUM
EXTERNAL NTS,EXTRA,REST,ALPHA,DRWNT,FONT,BREP,FERMTA
EXTERNAL DAT,RHORZ,PLTR,MIN,POSI,ALF,RDRAW,AMOD,RJBX
%TEMP.: 0
DEFINE RX4 <.COMM.+=42>
DEFINE R3< .COMM.+4 >↔DEFINE R4< .COMM.+5 >↔DEFINE R5< .COMM.+6 >
DEFINE R6< .COMM.+7 >↔DEFINE R7< .COMM.+=8 >↔DEFINE J3< .COMM.+=24 >
DEFINE J4< .COMM.+=25 >↔DEFINE J5< .COMM.+=26 >↔DEFINE J6< .COMM.+=27 >
DEFINE J8< .COMM.+=29 >↔DEFINE R9< .COMM.+=10 >↔DEFINE R8< .COMM.+=9 >
DEFINE J2< .COMM.+3 >↔DEFINE J10< .COMM.+=31 >↔DEFINE J7< .COMM.+=28 >
DEFINE RMINI< ALF+=49 >↔DEFINE RINV< ALF+=50 >↔DEFINE RJZ< .COMM.+=23 >
DEFINE RA< ALF+=51 >↔DEFINE RX< ALF+=52 >↔DEFINE RJX< ALF+=53 >
DEFINE RJY< ALF+=54 >↔DEFINE RB< ALF+=55 >↔DEFINE RJW< ALF+=56 >
DEFINE RZ< ALF+=57 >↔DEFINE JX< ALF+=58 >↔DEFINE RG< ALF+=59 >
DEFINE KL< ALF+=60 >↔DEFINE RJAC< ALF+=61 >↔DEFINE K < ALF+=62 >
DEFINE L < ALF+=63 >↔DEFINE RQ< ALF+=64 >↔DEFINE RH< ALF+=65 >
DEFINE J5X< ALF+=66 >↔DEFINE RXX< ALF+=67 >↔DEFINE JJJ< ALF+=68 >
DEFINE JY< ALF+=70 >↔DEFINE RJ< ALF+=71 >↔DEFINE RSTJ2< STF+=8 >
DEFINE PLT< PLTR >↔DEFINE POS< POSI+=9 >↔DEFINE JA< .COMM.+1 >
DEFINE CENTR< .COMM.+2 >↔DEFINE RACNT< DAT >↔DEFINE RDOT< DAT+=65 >
DEFINE XAC< DAT+=82 >↔DEFINE RACCI< DAT+=111 >↔DEFINE NACCI< DAT+=133 >
DEFINE STEM<.COMM.+=43>↔DEFINE R11<.COMM.+=12>↔DEFINE J11<.COMM.+=32>
; 00010 C********** FOR NOTE DRAWING, RESTS ACCENT AND OTHER MARKS.
; 00100 SUBROUTINE NOTWRT
; 00200 IMPLICIT INTEGER(A-Q,S-Z)
; 00300 COMMON/DL/IXRX,M,AA /FONT/JFONT
;00600 COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
; 00700 REAL DIS,CENTR,POS,STFF,XDIS
; 00800 COMMON /STF/RSTFAC(-3/4),RSTJ2
; 00900 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
; 01000 COMMON/PLTR/PLT,RHT,DIS,XDIS /POSI/STFF(-3/4),JJ2,POS
;01110 C ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
;01200 COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
; 01300 1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,J5X,RXX,JJJ,
; 01400 1 PUNCT,JY,RJ
;01500 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
;01600 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8)),
;01700 1(J11,JQ(9)),(J6,JQ(4)),(R5,RJQ(3)),(R11,RJQ(9)),(STEM,JQ(20))
;01800 1,(R8,RJQ(6)),(R7,RJQ(5)),(RX,JRX),(RJZ,RJQ(20)),(R3,RJQ(1))
; 01850 1,(RX4,JQ(19)),(J5X,RZTM)
NOTWRT: 0 ; 04300 RSTX=RSTJ2
MOVE 02,RSTJ2
MOVEM 02,ALF+=48 ; 04400 C FOR MINIS AT 245
; 04500 RMINI=RSTJ2
MOVEM 02,RMINI ;OR SHOULD THIS ONLY BE IN NOTES, ETC? 15/9/72
FMPRI 02,203700 ; 04100 RST7=7.*RSTJ2
MOVEM 02,ALF+=46 ; 04800 RINV=1
MOVSI 02,201400
MOVEM 02,RINV ; 04810 RX4=R4
MOVE 02,R4
MOVEM 02,RX4
MOVE JA ; 04900 IF(JA.EQ.1)GO TO 11
CAIN 1
JRST A11
CAIN =9 ;05000 IF(JA.EQ.9)GO TO 242
JRST A242 ; 05200 C NEXT IS FOR RESTS
MOVM J4 ; 05210 IF(IABS(J4).LT.480)GO TO 302
CAIGE 00,740
JRST A302 ; 05220 C P4+500= USER-ADDED RESTS
JSA 16,EXTRA ; 05240 RETURN
JRA 16,(16)
A302: MOVE J5 ; 05300 302 IF(R8.NE.0.AND.J5.NE.-4)J5=-2
MOVE 02,R8 ;J5=-4 MAKES REPEAT BAR SIGN
JUMPE 02,.+5
CAMN [-4]
JRST .+3
MOVNI 2
MOVEM J5 ; R8 PUTS NUMBER OVER WHOLE REST ONLY.
CAIG 1 ; 05500 IF(J5.GT.1)R4=R4-2
JRST .+3
MOVSI 02,575400
FADRM 02,R4 ; 05700 R7=R6*10.
MOVSI 02,204500
FMPR 02,R6
MOVEM 02,R7 ; 05800 C FOR DOTS
CAIGE 2 ; 05850 IF(J5.GE.2)R3=R3-3.0*RSTJ2
JRST .+5
MOVSI 02,202600
FMPR 02,RSTJ2
FSBRM 02,R3
MOVNS 00,R3 ; SHIFTS 1/16 AND SMALLER RESTS .5 TO LEFT
; 05900 202 CALL REST
A202: JSA 16,REST ; 06000 IF(J5.GT.1)GO TO 200
MOVEI 02,1
CAMGE 02,J5
JRST A200
SKIPN R7 ; 06100 IF(R7.EQ.0)RETURN
JRA 16,(16) ; 06200 201 RA=14
A201: MOVSI 02,204700 ; 06300 R6=0
SETZM R6
SKIPGE J5 ; 06400 IF(J5)RA=19
MOVSI 02,205460
;; MOVEM 02,RA
; 06500 R3=R3+RA*RSTJ2
FMPR 02,RSTJ2
FADRM 02,R3 ; 06600 R4=8.+R4
MOVSI 02,204400
FADRM 02,R4 ; 06700 JA=9
MOVEI 02,11
MOVEM 02,JA ; 06800 J5=7
MOVEI 02,7
MOVEM 02,J5 ;C IF P6=1 THE REST IS DOTTED
; 07000 CALL CENTX
JSA 16,CENTX ; 07100 GO TO 242
JRST A242 ; 07200 200 J5=J5-1
A200: SOS J5 ; FOR MULTIPLE TAILS ON 16TH REST, ETC.
; 07400 R4=R4+2.
MOVSI 02,202400
FADRM 02,R4 ; 07500 CALL RJBX(4.3)
JSA 16,RJBX
JUMP 02,[4.3] ; 07600 GO TO 202
JRST A202
A29: MOVEM 02,RJX ; 07800 29 RJX=R3
; 07900 RJY=CENTR+RSTJ2
MOVE 02,RSTJ2
FADR 02,CENTR
MOVEM 02,RJY ;8000 108 IF(WHOLE.NE.0)RJX=RJX+3.*RMINI
A108: MOVE 02,WHOLE#
JUMPE 02,.+5
MOVSI 02,202600
FMPR 02,RMINI
FADRM 02,RJX ;WHOLE=1 MEANS IT'S A WHOLE NOTE (WIDER THAN A HALF.)
; 08200 WHOLE=0
SETZM WHOLE ;8210 RG=9
MOVSI 02,204440
SKIPGE PLT ; 08220 IF(PLT)RG=17
MOVSI 2,205420
MOVEM 02,RG ; 08230 DOESN'T FILL DOT ON DPY
; 08300 107 CALL RDRAW(1,RG,RDOT,RMINI,RJX,RJY,RMINI)
A107: JSA 16,RDRAW
JUMP 00,[1]
JUMP 02,RG
JUMP 02,RDOT
JUMP 02,RMINI
JUMP 02,RJX
JUMP 02,RJY
JUMP 02,RMINI
;08400 **** **** *** ↑↑↑↑↑↑↑↑↑↑ THESE WERE RSTJ2 11/74
; 08500 IF(JA.EQ.1)GO TO 290
MOVEI 02,1
CAMN 02,JA
JRST A290 ; 08600 IF(R7.GE.20.)GO TO 290
MOVSI 02,205500
CAMG 02,R7
JRST A290 ; 08700 RB=POS+52.*RSTJ2
MOVSI 02,206640
FMPR 02,RSTJ2
FADR 02,POS
MOVEM 02,RB
CAME 2,RJY ; 08800 IF(RJY.NE.RB)GO TO 6241
JRST A6241
; 08900 C WHERE IS RB USED LATER?
; 09000 RJY=RJY-12*RSTJ2
MOVSI 02,204600
FMPR 02,RSTJ2
FSBRM 02,RJY
MOVNS 00,RJY ; 09100 GO TO 107
JRST A107 ; 09200 C ABOVE FOR DOTS
; 09300 290 R7=R7-10.
A290: MOVN 02,[10.0]
FADRB 02,R7
CAMGE 2,[10.0] ; 09400 IF(R7.LT.10.)GO TO 1342
JRST A1342 ;9500 RJX=RJX+RSTJ2*10.
MOVSI 02,204500
FMPR 02,RSTJ2
FADRM 02,RJX ; 09600 GO TO 107
JRST A107 ; 10000 C NOTES****
; 10200 11 CALL NTS
A11: JSA 16,NTS
SKIPGE STEM ; 10300 IF(STEM)RETURN
JRA 16,(16) ;10400 R4=RX4
MOVE 02,RX4
MOVEM 02,R4
A1242: MOVSI 02,204500 ;31500 1242 IF(R7.LT.10.)GO TO 1342
CAMLE 02,R7
JRST A1342 ; C FOR DOTTED NOTE-- P7>9
; 31700 RJX=RJAC+(22.+AMOD(R7,1.0)*59.6)*RMINI
JSA 16,AMOD
JUMP 02,R7
JUMP 02,[1.0]
FMPR 00,[59.6]
FADRI 00,205540
FMPR 00,RMINI
FADR 00,RJAC
;; MOVEM 00,RJX
; 31800 C***↑↑↑↑↑ WAS 24. 11/74
MOVE 02,RSTJ2 ;31900 RJY=CENTR+RSTJ2
FADR 02,CENTR
MOVEM 02,RJY
MOVE 2,JY ; TO USE LATER
MOVSI 3,207620 ; IF(R7.LT.100)GO TO A12
CAMLE 3,R7
JRST A12 ; SAVE +100 OR -100 IN AC3
MOVNS 3 ; R7=R7-100
FADRM 3,R7 ;ADD 100 TO R7 TO PUT DOT BELOW NOTE.
CAIE 2,=20 ; SKIP NEXT IF JY=20 (NOTE TO LFT OF STEM)
FADR 0,[14.54] ; RJX=RJX+14.54
A12: CAIN 2,12 ;32000 IF(JY.EQ.10)RJX=RJX+14.54
FADR 0,[14.54] ;32200 4322 RJX=RJX+RSTM
MOVEM 0,RJX ; PUT AWAY RJX
;32300 C MOVES DOT TO LEFT
A3322: MOVE J4 ;32400 3322 IF(MOD(J4,2).EQ.0)GO TO 108
IDIVI 2
JUMPE 1,A108 ; 32500 RX=RST7
MOVE 02,ALF+=46
;;; MOVE JY ; 32600 IF(JY.GE.20)RX=-RX
SKIPGE 3 ; IF -100 RX=-RX
;; CAIL =20
MOVNS 2 ; ADD 100 TO R7 FOR DOTS BELOW! NOTE
FADRM 02,RJY ;32700 3342 RJY=RJY+RX
; 32800 GO TO 108
JRST A108 ; 33000 1342 IF(J5.NE.0)GO TO 5322
A1342: MOVE 02,J5
JUMPN 02,A5322
SKIPN R6 ; 33100 IF(R6.EQ.0)RETURN
JRA 16,(16) ;33200 5322 R3=R3-R5*59.6*RMINI
A5322: MOVE 02,[59.6]
FMPR 02,R5
FMPR 02,RMINI
FSBRM 02,R3
MOVNS 00,R3 ; 33300 C TO SPACE OUT ACCIDS.
A242: MOVE 1,J5 ; 33700 242 IF(J5.GE.0)GO TO 2421
JUMPGE 1,A2421 ; 33800 RINV=-RINV
MOVNS 00,RINV ; 33900 J5=-J5
MOVNS 00,J5 ;NOW THAT 0 NOT USED FOR DOTS, ABOVE 3 LINES COULD BE CHNGD
; 34100 C********** LAST # WAS 281?
; 34200 C B,#,NAT, ACC ↑, ACC >, FERMATA, DOT, REP MEAS., DASH
; 34400 2421 J5X=-1
A2421: SETOM J5X ; 34500 JAX=JA
MOVE 02,JA
MOVEM 02,JAX# ; 34600 C USED AT 4241 FOR DOUBLE MARKS ON NOTES.
CAIN 02,11 ; 34700 IF(JA.EQ.9)GO TO 2423
JRST A2423 ; 34800 IF(J5.GT.3)GO TO 3121
CAILE 1,3 ; AC1 IS USED AT A211!!!
JRST A3121
;34900 C DBL FLT(4) AND DBL SHRP(5) ALWAYS USE 'DRAW' ROUTINE.
JRST A211 ; 35000 GO TO 211
; 35100 2423 RJZ=R4
A2423: MOVE 02,R4
MOVEM 02,RJZ
; 35200 C FOR 'DRWNT' WHEN PLOTTING.
; 35300 CALL NOZERO(R6)
SKIPN 2,R6
MOVE 2,[1.0] ; 35400 C R6=SIZE FACTOR (P6)
; 35500 RMINI=RMINI*R6
FMPRM 02,RMINI ; 35600 R6=0
SETZM R6 ; 35700 STEM=0
SETZM STEM ; 35800 C FOR MISC. ITEMS
A210: MOVM J4 ; 35900 210 IF(IABS(J4).LT.100)GO TO 1241
CAIGE 00,144
JRST A1241
MOVE J4 ; 36100 J4=MOD(J4,100)
IDIVI =100
MOVEM 1,J4 ; 36200 RMINI=.7*RMINI
MOVE 02,[0.7]
FMPRM 02,RMINI ;36400 C FOR 2 MARKS AT ONCE.
A1241: MOVE J5 ; 36500 1241 IF(J5.GE.11)GO TO 28
CAIL 13
JRST A28 ; GO TO (211,211,211,28,28,222,249,60,27,27),J5
SKIPLE 01,J5
CAILE 01,12
SKIPA 0
M13: JRST @M13 (1)
JUMP 00,A211
JUMP 00,A211
JUMP 00,A211
JUMP 00,A28
JUMP 00,A28
JUMP 00,A222
JUMP 00,A249
JUMP 00,A60
JUMP 00,A27
JUMP 00,A27 ; 36700 RETURN
JRA 16,(16) ; 36800 C ERROR TRAP (I.E. J5=0)
; 36900 C FOR 1 OR 2 BAR REP SIGNS.
; 37000 60 CALL BREP
A60: JSA 16,BREP ; 37100 RETURN
JRA 16,(16) ; 37300 241 CALL LINES(R3,CENTR,3)
A241: JSA 16,LINES
JUMP 02,R3
JUMP 02,CENTR
JUMP 00,[3] ; 37400 GO TO 210
JRST A210 ; 37700 211 IF(J5.EQ.0)GO TO 2422
;;;A211: MOVE 02,J5
A211: JUMPE 1,A2422 ; 37800 C GETS BACK GOOD VERTICAL POS.
CAILE 1,3 ; 37900 IF(J5.GT.3)GO TO 222
JRST A222 ; FOR 2-PASS PLOTTING (-2=THIN LINES, -3=HEAVY LINES)
; 38100 IF(PLT)GO TO 3121
MOVE 02,PLT
JUMPL 02,A3121 ; 38200 IF(JFONT.NE.0)GO TO 3121
MOVE 02,FONT
JUMPN 02,A3121 ; 38300 X=NACCI(J5)
;; MOVE 03,J5
MOVE 02,NACCI -1(1)
;;; MOVEM 02,X
;38400 CALL RDRAW(X+1,RACCI(X),RACCI,RMINI,R3,CENTR,RMINI)
;;; MOVEI 02,1
;;; ADD 02,X
AOJ 2,
MOVEM 02,%TEMP.
;;; MOVE 04,X
;;; MOVEI 03,RACCI -1(4)
MOVEI 03,RACCI -2(2)
HRRM 03,AA14
JSA 16,RDRAW
JUMP 00,%TEMP.
AA14: JUMP 02,AA14
JUMP 02,RACCI
JUMP 02,RMINI
JUMP 02,R3
JUMP 02,CENTR
JUMP 02,RMINI ; 38500 2422 IF(R6.EQ.0)RETURN
A2422: SKIPN 2,R6
JRA 16,(16)
JUMPG 2,B24 ;IF(R6.GT.0)GO TO B24
JSA 16,AMOD ;X=AMOD(R12,1.0) GET THE VERT. SPACE, IF ANY.
JUMP R11 ;R11=1407.2 MEANS 'PLUS & DOT UP 2 STEPS'.
JUMP [1.0] ;R11 INFOR WILL OVER RIDE R6 INFO!!!
FMPR [70.0] ;X*10*7 (7 UNITS PER BASIC VERTICAL STEP.)
MOVEM R11 ;R11 NOW HAS VERTICAL DISPLACEMENT
MOVE 0,J11
IDIVI 0,=100 ;REMAINDER WILL BE IN AC1 (RIGHT 2 DIGITS)
CAIL 1,=10 ;IF(AC1.GE.10)AC1=AC1*10
IMULI 1,=10
JRST B224 ;GET THE CORRECT MARK NUMBERS BELOW
B24: CAMGE 2,[0.1] ;IF(R6.LT..1)RETURN 4/76
JRA 16,(16) ;SO UP TO .0099 CAN BE PUT IN P6 FOR 'EXTRA'
MOVE 02,[0.001] ;38600 J5=(R6+.001)*100.
FADR 02,R6
FMPRI 02,207620
KIFIX 1,2
B224: MOVE 02,RX4
MOVEM 1,J5 ; 38700 R4=RX4
MOVEM 02,R4 ; 38900 R3=RJAC
MOVE 02,RJAC
MOVEM 02,R3
A1249: MOVE J5 ; 39000 1249 IF(MOD(J5,10).GT.3)GO TO 249
IDIVI 12
CAILE 1,3
JRST A249 ; 39100 J5=J5/10
MOVEM 0,J5
CAIL =40 ;39200 IF(J5.GT.39)GO TO 1249
JRST A1249 ;WHEN P1=1, EXTRACTS ACCENT NUMBERS FROM DECIS IN P6.
; 39400 249 IF(J5.GT.30)GO TO 28
A249: MOVE J5
CAILE 36
JRST A28
CAILE 12 ; 39500 IF(J5.GT.10)GO TO 246
JRST A246
SKIPN J5 ; 39600 IF(J5.EQ.0)RETURN
JRA 16,(16) ;39700 IF(JA.NE.1)GO TO 250
MOVEI 02,1
CAME 02,JA
JRST A250 ; 39900 RB=14.
MOVSI 02,204700 ;R11 WILL BE 0 IF R6 HAD MARKS INFO
MOVEM 02,RB
MOVE 1,J4 ; 40000 IF(MOD(J4,2).EQ.0)GO TO 244
IDIVI 1,2
JUMPE 2,A244
CAIN 7 ; 40100 IF(J5.EQ.7)GO TO 6322
JRST A6322
CAIE =9 ; 40200 IF(J5.NE.9)GO TO 244
JRST A244
A6322: MOVE 3,J4 ; 40300 6322 IF(STEM.GT.1)GO TO 7322
MOVE 1,STEM
CAILE 1,1
JRST A7322 ; 40400 IF(J4.LT.5)GO TO 244
CAIGE 3,5
JRST A244
A7322: CAIG 3,=9 ;40500 7322 IF(J4.LE.9)GO TO 8322
JRST A8322
CAIN 1,2 ; 40600 IF(STEM.EQ.2)GO TO 244
JRST A244
JUMPE 1,A244 ; 40700 IF(STEM.EQ.0)GO TO 244
; 40800 8322 RB=21
A8322: MOVSI 02,205520
MOVEM 02,RB
;40900 C PUTS ACCENT DOWN OR UP 1 SPACE. AVOIDS PUTTING DOT OR DASH ON LINE
A244: MOVE 2,STEM ; 41000 244 IF(STEM.EQ.1)GO TO 9322
CAIN 2,1
JRST A9322
JUMPN 2,A245 ; 41100 IF(STEM.NE.0)GO TO 245
; 41200 IF(J4.GE.7)GO TO 245
MOVEI 02,7
CAMG 02,J4
JRST A245 ; 41300 9322 RB=-RB
A9322: MOVNS 00,RB ; 41700 245 CENTR=CENTR+RB*RSTX
MOVNS R11 ;R11= THE VERT. DISPLACEMENT
A245: MOVE 02,RB
FADR 2,R11
FMPR 02,ALF+=48
FADRM 02,CENTR
SETZM R11
A250: CAILE 12 ;41800 250 IF(J5.GT.10)GO TO 281
JRST A281
CAIGE 6 ; 41900 IF(J5.LT.6)GO TO 281
JRST A281 ; 42000 JA=9
MOVEI 02,11
MOVEM 02,JA
CAIE 7 ; 42100 IF(J5.NE.7)GO TO 253
JRST A253 ; 42200 C 7=DOT
; 42300 RXX=R3
MOVE 02,R3
MOVEM 02,RXX ; 42400 R3=R3+6.7*RMINI
MOVE 02,[6.7]
FMPR 02,RMINI
FADRB 02,R3 ; 42500 C CENTERS THE DOT
; 42600 GO TO 29
JRST A29
A253: CAIN 11 ; 42700 253 IF(J5.EQ.9)GO TO 271
JRST A271 ;42800 C 9=DASH
; 42900 251 IF(RB.LT.0)RINV=-RINV
A251: SKIPGE RB
; 43000 C FIX THIS!!!! FOR BOWINGS, ETC.
A2222: SKIPN 2,R11
JRST AALPH
FADRM 2,CENTR
FDVR 2,[7.0] ; GET DISPLACEMENT IN SCALE STEPS
FADRM 2,R4 ;ADD TO HEIGHT
SETZM R11
MOVE 1,STEM
CAIN 1,1 ;IF(STEM.EQ.1)R11=-R11 FOR WEDGE
MOVNS 2
FADRM 2,RX4
AALPH: CAIE 24 ; 43100 2222 IF(J5.NE.20)GO TO 2223
JRST A2223 ; 43300 JA=7
MOVEI 02,7
MOVEM 02,JA ; 43400 R5=0
SETZM R5 ; 43500 J7=1
MOVEI 02,1
MOVEM 02,J7 ; 43600 CALL ALPHA
JSA 16,ALPHA ; 43700 C FOR TRILL -- J5=20
JRA 16,(16)
A2223: CAIN 21 ; 43900 2223 IF(J5.EQ.17)GO TO 323
JRST A323
CAIE 22 ; 44000 IF(J5.NE.18)GO TO 222
JRST A222 ; 44100 323 RINV=J5
A323: FLTR 0,0 ; FLOAT IT.
MOVEM 0,RINV ; 44200 C FOR MORD, INV.MORD
A222: JSA 16,FERMTA ; 44400 GO TO 5241
JRST A5241
A246: CAIGE 12 ; 44800 246 IF(J5.LT.10)GO TO 245
JRST A245 ; 45020 RZ=3
MOVSI 02,202600 ; 45040 IF(STEM.EQ.1)RZ=9+R8
MOVEI 3,1
CAME 3,STEM
JRST .+3
MOVSI 02,204440
FADR 02,R8
;;;;;; MOVEM 02,RZ
FMPR 02,RMINI ;45060 R4=R4+RZ*RMINI/RSTJ2
FDVR 02,RSTJ2
FADRB 02,R4
CAML 2,[12.5] ; 45100 IF(R4.LT.12.5)R4=12.5
JRST .+3
MOVSI 02,204620
MOVEM 02,R4 ; 45200 CALL CENTX
JSA 16,CENTX
MOVE J5 ; 45300 IF(J5.EQ.26)GO TO 222
CAIE 32
JRST A28
MOVE R11 ;R11=DISPLACEMENT
FADRM CENTR
JRST A222 ; 45400 C 26 IS NEW NUMB FOR FERMATA.
A28: CAIGE =30 ; 45500 28 IF(J5.LT.30)GO TO 281
JRST A281 ; PRINTS ONLY NUMS 0→5 AS FINGERINGS OVER NOTES.
CAIL =36 ;IF(J5.GE.36)GO TO A28X
JRST A28X
SUBI =30 ;R5=J5-30 GET THE 1 DIGIT NUM.
FLTR ; FLOAT IT
MOVEM .COMM.+6 ; R5
MOVE [0.7] ;0.7
MOVEM .COMM.+7 ; R6=.75 SIZE OF NUM.
MOVSI 0,203600 ;GET 6.0
MOVEI 2,2
CAME 2,STEM ;IF(STEM.EQ.1) SHIFT 2 TO RIGHT
FADR 0,[2.0]
FMPR 0,STF+=8 ;* RSTJ2
KIFIX ;FIXIT
ADDM .COMM.+30 ;JX3=JX3+RSTJ2*6.0 GET REAL R3 BACK,PUSH LEFT.
SETZM .COMM.+=8 ;R7=0
SETZM .COMM.+=9 ;R8=0
SETZM .COMM.+=10 ;R9=0
MOVSI 202500 ;RA=2.5
MOVEI 2,1 ;IF(STEM.EQ.2)RA=-RA
CAME 2,STEM
JRST .+3
MOVNS
FSBR [1.5]
FLTR 2,.COMM.+=25 ; GET J4 (R4 AND RX4 GET CHANGED IN TAILS)
FADR 2 ;R4=J4+RA HGT OF NUM.
MOVEM .COMM.+5
JSA 16,MAKNUM ;CALL MAKNUM(R5)
JUMP .COMM.+6
JRA 16,(16) ;ADD HERE FOR NUMS WITH ACCENTS, ETC.
A28X: IDIVI 12 ; 45600 J5X=MOD(J5,10)
MOVEM 1,J5X ; 45700 C J5X SAVES NEXT MARK.
CAIGE 1,4 ; 45800 IF(J5X.LT.4)J5X=0
SETZM J5X ; 45900 J5=J5/10
MOVEM 0,J5
CAILE =30 ; 46000 IF(J5.GT.30)RETURN
JRA 16,(16) ;46100 C WON'T READ 415 ETC. (CORRECT=154)
; 46200 C DOES BOTTOM MARK FIRST, THEN TOP.
EXCH J5X ; 46300 CALL EXCH(J5X,J5)
MOVEM J5 ; PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
MOVEI 02,1 ; 46500 IF(JA.EQ.1)GO TO 249
CAMN 02,JA
JRST A249 ; 46600 GO TO 1241
JRST A1241 ; 46700 281 X=1
A281: MOVEI 02,1
MOVEM 02,X#
CAILE =16 ; 46800 IF(J5.GT.16)GO TO 2222
JRST A2222 ; 46900 C JUMP FOR MORD, INV.MORD, TRILL
CAIE 4 ; 47000 IF(J5.NE.4)GO TO 228
JRST A228 ; 47100 X=5
MOVEI 02,5
MOVEM 02,X ; 47200 CALL RJBX(.5)
JSA 16,RJBX
JUMP 02,[0.5] ; 47300 GO TO 328
JRST A328 ; 47400 228 IF(J5.GT.10)X=XAC(J5-10)
A228: CAIG 12
JRST .+4
MOVE 03,J5
MOVE 02,XAC -13(3)
MOVEM 02,X ;47500 C X IS POINTER IN RACNT ARRAY
A328: MOVE 02,RMINI ; 47600 328 RA=RMINI
MOVEM 02,RA ; C OR RSTJ2?
MOVE 02,RINV ; 47800 IF(RINV.LT.0)GO TO 1323
JUMPL 02,A1323 ;47900 IF(STEM.NE.1)GO TO 2323
MOVEI 02,1
CAME 02,STEM
JRST A2323
CAIE 4 ; 48000 IF(J5.NE.4)GO TO 2323
JRST A2323 ; 48100 1323 RA=-RA
A1323: MOVNS 00,RA ;48200 C ↑↑↑ X ↑↑↑ PICKS UP TYPO ERRORS
;48300 2323 IF(X.LT.54)CALL RDRAW(X+1,RACNT(X),RACNT,RA,R3,CENTR,RMINI)
A2323: MOVEI 02,66
CAMG 02,X
JRST A5241
MOVEI 02,1
ADD 02,X
MOVEM 02,%TEMP.
MOVE 03,X
MOVEI 03,RACNT -1(3)
HRRM 03,AA24
SETZM JTH# ;JTH=0
SKIPL PLTR ;IF(IPLT.GE.0)GO TO AA1
JRST AA1
MOVNI 2
MOVEM JTH ;JTH=-2
AA1: MOVE CENTR
FADR R11 ;RJJJ=CENTR+R11 (DISPLACEMENT UNIT)
MOVEM JJJ
JSA 16,RDRAW
JUMP 00,%TEMP.
AA24: JUMP 02,AA24
JUMP 02,RACNT
JUMP 02,RA
JUMP 02,R3
JUMP 02,JJJ
JUMP 02,RMINI ; PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
;48500 IN ARRAY, 33.012 WOULD BE X=33, Y=12. 101.123 IS X=-1, Y=-23.
SKIPL JTH ; 48600 IF(JTH.GE.0) GO TO 5241
JRST A5241 ; 48700 4241 JJJ=J5
AOS JTH ;JTH=JTH-1
MOVE 1,RMINI
MOVE J5 ;IF(J5.NE.13)GO TO AA27 13=HARMONIC
CAIE =13
JRST AA27
FADR 1,[0.02] ;RMINI=RMINI+.02
JRST AA1
AA27: MOVN 1,PLTR+3
CAIN =14 ;IF(J5.EQ.14)R3=R3+XDIS 14= +
FADRM 1,R3
FADRM 1,CENTR ;CENTR=CENTR-XDIS TO THICKEN > - ∧ ETC. WHEN PLOTTING
JRST AA1 ;GO TO AA1
A4241: MOVE 1,J5 ;*****WHERE IS JJJ USED????***********
MOVEM 1,JJJ ; 48800 J5=J5X
MOVE J5X
B4241: MOVEM J5 ; 48900 J5X=-1
SETOM J5X ; 49000 IF(JAX.NE.1)GO TO 7241
MOVEI 02,1
CAME 02,JAX
JRST A7241
CAILE 12 ; 49100 IF(J5.GT.10)GO TO 246
JRST A246
CAIE 7 ; 49200 IF(J5.NE.7)GO TO 7241
JRST A7241
CAIE 1,=9 ; 49300 IF(JJJ.NE.9)GO TO 249
JRST A249 ; 49400 7241 RXX=8.5*RMINI
A7241: MOVSI 02,204420
FMPR 02,RMINI
MOVEM 02,RXX ; 49500 C↑↑↑↑↑↑ 11/74 WAS RH*
MOVEI 02,1 ; 49600 IF(STEM.EQ.1)RXX=-RXX
CAMN 02,STEM
MOVNS 00,RXX ; 49700 CENTR=CENTR+RXX
MOVE 02,RXX
FADRM 02,CENTR
CAIE 32 ; 49800 IF(J5.EQ.26)J5=6
JRST A1241
MOVEI 02,6
MOVEM 02,J5 ; 49900 C TEMPORARY?? FIX
; 50000 GO TO 1241
JRST A1241 ; 50100 C >=5, ↑=4
; 50200 27 R3=J3
A27: FLTR 2,J3 ;MOVE 2,J3
; TLC 2,232000
; FADR 2,2
MOVEM 2,R3 ; 50300 C DASHES
A271: MOVSI 02,204700 ;50400 271 CALL LINX(R3,CENTR,R3+RMINI*14.,CENTR)
FMPR 02,RMINI
FADR 02,R3
MOVEM 02,%TEMP.
JSA 16,LINX
JUMP 02,R3
JUMP 02,CENTR
JUMP 02,%TEMP.
JUMP 02,CENTR
SKIPL PLTR
JRST A5241 ;MAKE THICKER IF PLOTTING
MOVN PLTR+3 ;CENTR=CENTR-XDIS (1/DIS)
FADRM CENTR
JSA 16,LINX
JUMP 02,R3
JUMP 02,CENTR
JUMP 02,%TEMP.
JUMP 02,CENTR
A5241: MOVE 0,J11 ;IF(J11.EQ.0)GO TO B5241
JUMPE B5241
IDIVI 0,=100
SETZM J11 ;J11=0 SO IT WILL PASS HERE SECOND TIME AROUND.
SETZM R11 ;R11=0 SO DOUBLE MARKS WON'T BE MOVED UP TWICE.
JRST B4241 ; GO TO B4241
B5241: MOVE 02,J5X ; 50600 5241 IF(J5X.GT.0)GO TO 4241
JUMPG 02,A4241 ;J5X IS FOR DOUBLE MARKS.(WHAT ABOUT DOT POSITION.)
; 50800 RETURN
JRA 16,(16) ; 50900 6241 R3=RXX
A6241: MOVE 02,RXX
MOVEM 02,R3 ;51000 C RESET R3 AFTER A DOT.
; 51100 GO TO 5241
JRST A5241 ; 51200 3121 J5=J5+9
A3121: MOVEI 02,11
ADDM 02,J5 ; SOON WILL HAVE DBL FLAT (4) AND DBL SHRP (5)
;51400 C TO DRAW GOOD ACCIS ON PLOTTER - NOT ON DPY.(IN CLEF4.DMD)
; 51500 CALL DRWNT
JSA 16,DRWNT ; 51600 GO TO 2422
JRST A2422
END ; 51700 END